library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.2     ✔ readr     2.1.4
## ✔ forcats   1.0.0     ✔ stringr   1.5.0
## ✔ ggplot2   3.4.2     ✔ tibble    3.2.1
## ✔ lubridate 1.9.2     ✔ tidyr     1.3.0
## ✔ purrr     1.0.1     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(plotly)
## 
## Attaching package: 'plotly'
## 
## The following object is masked from 'package:ggplot2':
## 
##     last_plot
## 
## The following object is masked from 'package:stats':
## 
##     filter
## 
## The following object is masked from 'package:graphics':
## 
##     layout

constants

income related constants

adult <- 4529
child <- 200

unemployed_factor <- 0.7

alimony <- c(0, 0.15, 0.25, 0.30) # alimony rate for 0, 1, 2, and 3  children

expenditure constants

a1c0 <- 3977
a2c0 <- 6605
a2c1 <- 7057
a2c2 <- 7635
a2c3 <- 7968

For single parent households there is no differentiating between number of children. Let’s use analoguous value from two parent households and scale accordingly after disentangling the costs for the adult and the children.

a1cx <- 5354.18
a2cx <- 7492.73

a1c1 <-a1c0 + (a2c1-a2c0)/(a2cx-a2c0)*(a1cx-a1c0)
a1c2 <-a1c0 + (a2c2-a2c0)/(a2cx-a2c0)*(a1cx-a1c0)
a1c3 <-a1c0 + (a2c3-a2c0)/(a2cx-a2c0)*(a1cx-a1c0)

create tables for incomes and expenditures

create data frame with incomes

df_income <-crossing(
    employment_level = c(1, 0.75, 0.5),
    cohabiting_partner = c('none', 'working','not working'),
    children = 0:3
  ) %>% 
  mutate(
    income = adult * employment_level + child * children + case_when(
      cohabiting_partner == 'not working' ~ adult * unemployed_factor,
      cohabiting_partner == 'working' ~ adult,
      cohabiting_partner == 'none' ~ adult * alimony[children+1]
    ),
    adults = ifelse(cohabiting_partner == 'none', 1, 2)
  )

create data frame with the expenditures

df_exp <- tibble(
    adults = rep(1:2, each=4),
    children = rep(0:3, 2)
  ) %>%
  # get expenditure my name pattern
  rowwise() %>% 
  mutate(
    exp = get(paste0('a', adults, 'c', children))
  )

join them and use the ratio of income to expenditure of a single person working full-time as reference to scale all other combinations

df_final <- df_income %>%
  full_join(df_exp) %>%
  mutate(
    ratio = income/exp,
    sufficiency = ratio/(adult/a1c0),
  ) %>%
  arrange(cohabiting_partner, desc(employment_level))
## Joining with `by = join_by(children, adults)`
p  <-  df_final %>%
  ggplot(aes(x=children, y=sufficiency, fill=sufficiency, text=paste0(
      'income sufficiency:\n', round(sufficiency,3)
      ))) +
  geom_col() +
  facet_grid(employment_level ~ cohabiting_partner, labeller = labeller(
    cohabiting_partner = function(string) {paste0('cohabiting partner:\n', string)},
    employment_level = function(numeric) {paste0('employment:\n', as.numeric(numeric)*100,'%')}
  )) +
  guides(fill = 'none') +
  theme_minimal() +
  theme(plot.margin = margin(0.3,1,0.8,0.8, "cm")) +
  scale_fill_continuous(type = "viridis")

pp <- ggplotly(p, tooltip = "text") 
pp
api_create(pp, filename = "income_sufficiency")
## Found a grid already named: 'income_sufficiency Grid'. Since fileopt='overwrite', I'll try to update it
## Found a plot already named: 'income_sufficiency'. Since fileopt='overwrite', I'll try to update it